Shareware Grab Bag

home *** CD-ROM | disk | FTP | other *** search

/ Shareware Grab Bag / Shareware Grab Bag.iso / 007 / 8087.arc / 87MATMUL.BAS (.txt) < prev next >

Wrap

GW-BASIC | 1985-02-13 | 7.6 KB | 178 lines

1000 ' |----------------------------------------| 1010 ' | Matrix Premultiplication | 1020 ' | of a Three-Element Vector | 1030 ' | Personnel Computer Age 2.12 | 1040 ' |----------------------------------------| 1050 ' 1060 'Reserve space for 1070 'machine language subroutine 1080 CLEAR ,29999 1090 'Initialize screen, 1100 'variable types, 1110 'and data display formats 1120 :PRINT"Storing machine code...." 1130 DEFINT A-Z 1140 DIM A!(2,2), ACOPY!(2,2), X!(2), B!(2) 1150 F1$ = " ##.####^^^^ ##.####^^^^ ##.####^^^^" 1155 F1$ = F1$ + " ##.####^^^^" 1160 F2$ = "##.####^^^^" 1170 'Store machine language 1180 'subroutine and check for 1185 'errors in data statements 1190 '(i.e., machine language 1200 'hexidecimal values, "M") 1210 ADDR = 30000: CHKSUM = 19443 1220 READ M: IF M<>1000 THEN POKE ADDR,M:CHKSUM=CHKSUM-M:ADDR=ADDR+1:GOTO 1220ELSE IF CHKSUM=0 THEN 1320 1230 ' 1240 'Checksum error 1250 ' 1260 PRINT:PRINT "Coding errors in MATMUL87...":PRINT "please check DATA statements." 1270 ' 1280 END 1290 ' 1300 'Input transformation 1310 'matrix, "A" 1320 CLS:PRINT "Please provide the elements";:PRINT " of the transformation matrix." 1330 PRINT 1340 FOR R=0 TO 2:FOR C=0 TO 2 1350 LOCATE 10,10:PRINT "Row ";R+1; ", Column"; C+1;:INPUT A!(R,C) 1360 ACOPY!(R,C)=A!(R,C) 1370 LOCATE 10,10:PRINT SPC(30) 1380 NEXT:NEXT 1390 ' 1400 'Input vector to be 1410 'transformed, "X" 1420 CLS:PRINT "Please provide the elements";:PRINT " of the input vector." 1430 PRINT 1440 FOR R=0 TO 2 1450 LOCATE 10,10:PRINT "Row "; R+1;:INPUT X!(R) 1460 LOCATE 10,10:PRINT SPC(30) 1470 NEXT 1480 'Print transformation 1490 'matrix and input 1500 'vector elements 1510 CLS:PRINT 1520 PRINT " The Transformation Matrix is:";:PRINT SPC(22); "The Input vector is:" 1530 PRINT " ";STRING$(29,45);:PRINT SPC(22);STRING$(20,45) 1540 FOR R=0 TO 2 1550 PRINT 1560 PRINT USING F1$;A!(R,0),A!(R,1),A!(R,2),X!(R) 1570 NEXT 1580 'Call the 8087 subroutine, 1590 'or substitute the "regular" 1600 'BASIC subroutine provided 1610 'in the text. 1620 MATMULT87 = 30000 1630 CALL MATMULT87( ACOPY!(0,0),X!(0) ) 1640 FOR J=0 TO 2:B!(J)=X!(J):NEXT 1650 'Print the transformed 1660 'vector, "B" ( where B=AX ) 1670 ' 1680 LOCATE 12,27: PRINT "The Transformed Vector is:" 1690 LOCATE 13,27: PRINT STRING$(26,45) 1700 FOR R = 0 TO 2 1710 PRINT 1720 PRINT TAB(34);:PRINT USING F2$;B!(R) 1730 NEXT 1740 ' 1750 'Calculate another or exit 1760 ' 1770 LOCATE 22,2:PRINT "Do you wish to calculate another (y/n) ?" 1780 Q$=INKEY$:IF Q$="" THEN 1780 ELSE IF Q$="y" OR Q$="Y" THEN 1320 ELSE IF Q$="n" OR Q$="N" THEN 1790 ELSE BEEP: GOTO 1780 1790 CLS 1800 END 1810 ' 1820 ' |----------------------------------| 1830 ' | MATMULT87: 8087 3x3 Matrix | 1840 ' | Vector-Premultiplication | 1850 ' | Subroutine | 1860 ' |----------------------------------| 1870 'Set argument addresses 1880 DATA &h55: 'push bp 1890 DATA &h8B, &hEC: 'mov bp,sp 1900 DATA &h8B, &h76, &h08: 'mov si,[bp]+8 1910 DATA &h8B, &h7E, &h06: 'mov di,[bp]+6 1920 ' 1930 'Convert the "abandoned" 1940 'transformation matrix, ACOPY! 1950 DATA &hB9, &h09, &h00: 'mov cx,9 1960 DATA &h8B, &h44, &h02: 'mov ax,[si]+2 1970 DATA &h80, &hFC, &h02: 'cmp ah,2 1980 DATA &h72, &h0A: 'jb (+10) 1990 DATA &h80, &hEC, &h02: 'sub ah,2 2000 DATA &hD0, &hC0: 'rol al,1 2010 DATA &hD1, &hC8: 'ror ax,1 2020 DATA &h89, &h44, &h02: 'aov [si]+2,ax 2030 DATA &h83, &hC6, &h04: 'add si,4 2040 DATA &hE2, &hE9: 'loop (-23) 2050 DATA &h8B, &h76, &h08: 'mov si,[bp]+8 2060 ' 2070 'Repeat the process for 2080 'the input vector X! 2090 DATA &hB9, &h03, &h00: 'mov cx,3 2100 DATA &h8B, &h45, &h02: 'mov ax,[di]+2 2110 DATA &h80, &hFC, &h02: 'cmp ah,2 2120 DATA &h72, &h0A: 'jb (+10) 2130 DATA &h80, &hEC, &h02: 'sub ah,2 2140 DATA &hD0, &hC0: 'rol al,1 2150 DATA &hD1, &hC8: 'ror ax,1 2160 DATA &h89, &h45, &h02: 'mov [di]+2,ax 2170 DATA &h83, &hC7, &h04: 'add di,4 2180 DATA &hE2, &hE9: 'loop (-23) 2190 DATA &h8B, &h7E, &h06: 'mov di,[bp]+6 2200 'Perform the 2210 'matrix premultiplication. 2220 'Begin by setting a loop counter 2230 'and initializing the 8087. 2240 DATA &hB9, &h03, &h00: 'mov cx,3 2250 DATA &h9B, &hDB, &hE3: 'finit 2260 ' 2270 'Now place the components of X! 2280 'on the 8087 register stack 2290 DATA &h9B, &hD9, &h05: 'fld dword ptr [di] 2300 DATA &h9B, &hD9, &h45, &h04: 'fld dword ptr [di]+4 2310 DATA &h9B, &hD9, &h45, &h08: 'fld dword ptr [di]+8 2320 ' 2330 'Execute the premultiplication 2340 'loop 2350 DATA &h9B, &hD9, &h04: 'fld dword ptr [si] 2360 DATA &h9B, &hD8, &hCB: 'fmul st,st(3) 2370 DATA &h9B, &hD9, &h44, &h0C: 'fld dword ptr [si]+12 2380 DATA &h9B, &hD8, &hCB: 'fmul st,st(3) 2390 DATA &h9B, &hDE, &hC1: 'faddp st(1),st 2400 DATA &h9B, &hD9, &h44, &h18: 'fld dword ptr [si]+24 2410 DATA &h9B, &hD8, &hCA: 'fmul st,st(2) 2420 DATA &h9B, &hDE, &hC1: 'faddp st(1),st 2430 DATA &h9B, &hD9, &h1D: 'fstp dword ptr [di] 2440 DATA &h9B: 'fwait 2450 DATA &h83, &hC6, &h04: 'add si,4 2460 DATA &h83, &hC7, &h04: 'add di,4 2470 DATA &hE2, &hDA: 'loop (-38) 2480 ' 2490 'Reset SI and DI to point to 2500 'ACOPY!(0,0) and X!(0) 2510 DATA &h8B, &h76, &h08: 'mov si,[bp]+8 2520 DATA &h8B, &h7E, &h06: 'mov di,[bp]+6 2530 ' 2540 'Reconvert the results for 2550 'use by BASIC 2560 DATA &hB9, &h03, &h00: 'mov cx,3 2570 DATA &h8B, &h45, &h02: 'mov ax,[di]+2 2580 DATA &hD1, &hC0: 'rol ax,1 2590 DATA &hD0, &hC8: 'ror al,1 2600 DATA &h80, &hFC, &h00: 'cmp ah,0 2610 DATA &h74, &h03: 'je (+3) 2620 DATA &h80, &hC4, &h02: 'add ah,2 2630 DATA &h89, &h45, &h02: 'mov [di]+2,ax 2640 DATA &h83, &hC7, &h04: 'add di,4 2650 DATA &hE2, &hE9: 'loop (-23) 2660 ' 2670 'Restore the BP register 2680 'and return to BASIC 2690 DATA &h5D: 'pop bp 2700 DATA &hCA, &h04, &h00: 'ret 4 2710 ' 2720 '"Flag" value signals end of 2730 'data to terminate loops 2740 DATA 1000